home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / misc / math / TCalcStats2c.lha / TCalcStats2c / AREXX / Exponential_Smooth.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1999-02-07  |  7.7 KB  |  355 lines
  1. /* Exponential Smoothing */
  2.  
  3. options results
  4. if ~show('P','TCALC') then do
  5.     address command 'run turbocalc:turbocalc'
  6.     address command 'waitforport TCALC'
  7.     loadflag=1
  8. end
  9. address 'TCALC'
  10. 'DEFPUBSCREEN()'
  11. /* Add-in Rexx Math Library needed for some routines */
  12. signal on syntax
  13. if ~show('l','rexxmathlib.library') then
  14.    call addlib('rexxmathlib.library',0,-30) 
  15. if ~show('l','rexxreqtools.library') then
  16.    call addlib('rexxreqtools.library',0,-30)
  17. if ~show('l','rexxsupport.library') then
  18.    call addlib('rexxsupport.library',0,-30)
  19.  /* add to library list */
  20. signal off syntax
  21.  
  22. /* Start Main Routine */
  23. if loadflag=1 then 'Load()'
  24. 'ActivateWindow()'
  25. range=rtgetstring(,"Enter Cell Range for Input","Input Request") /*,,'rt_pubscrname="TCALC"')*/
  26. colon=pos(":",range)
  27. if colon=0 then do
  28.     'Message "Please select a range~before executing this script"'
  29.     'DEFPUBSCREEN("Workbench")'
  30.     exit
  31. end
  32.  
  33. /* Find cell references and cell, column numbers */
  34. start_cell=substr(range,1,colon-1)
  35. end_cell=substr(range,colon+1)
  36. start_row=cellrow(start_cell)
  37. end_row=cellrow(end_cell)
  38. start_col=cellcol(start_cell)
  39. end_col=cellcol(end_cell)
  40. NRows=end_row-start_row+1
  41. NCols=end_col-start_col+1
  42. if NCols>1 | NRows<4 then do
  43.     'Message "Only 1 column with 4 or more rows allowed"'
  44.     'DEFPUBSCREEN("Workbench")'
  45.     exit
  46. end
  47.  
  48. /* Get cell reference for output range */
  49. out_cell=rtgetstring(,"Enter Cell Reference for Output","Input Request") /*,,'rt_pubscrname="TCALC"')*/
  50. if out_cell="" then do
  51.     'DEFPUBSCREEN("Workbench")'
  52.     exit
  53. end
  54. if length(out_cell)<2 | datatype(left(out_cell,1),'n') then do
  55.     'Message "Invalid cell reference"'
  56.     'DEFPUBSCREEN("Workbench")'
  57.     exit
  58. end
  59. a=rtgetstring("0.3","Enter smoothing constant (default=.3)","Input Request") /*,,'rt_pubscrname="TCALC"')*/
  60. if rtresult=0 then do
  61.     'Message "Aborting!"'
  62.     'DEFPUBSCREEN("Workbench")'
  63.     exit
  64. end
  65. a=strip(a)
  66. a=a+1-1
  67. init=rtgetstring("0","Enter Initial Forecast Value or 0 to Use First Actual","Input Request")
  68. if rtresult=0 then do
  69.     'Message "Aborting!"'
  70.     'DEFPUBSCREEN("Workbench")'
  71.     exit
  72. end
  73. init=strip(init)
  74. init=init+1-1
  75.  
  76. /* Suppress Screen Redraw to Speed Things Up */
  77. 'Refresh 0'
  78.  
  79. /* Open a small output window on tcalc screen*/
  80. fo=0
  81. CR='0a'x
  82. DisplayMsg="Calculating...Please Wait."||CR||"User input is disabled during calculation."||CR
  83. if open(6Info, 'con:100/0/450/80/Progress/SCREEN TCALC', w) then do
  84.      call writeln(6Info, DisplayMsg)
  85.     fo=1
  86. end
  87. else do
  88.     'Message "TCALC Screen not available for Progress messages"'
  89. end
  90. CALL DELAY(150)
  91.  
  92. /* Get cell references for top cell in each column */
  93. 'SelectCell' start_cell
  94. do col=start_col to end_col
  95.     'GetCursorPos'
  96.     top_cell.col=result
  97.     'Column 1'
  98. end
  99.  
  100. /* Get labels for later use on output */
  101. 'SelectCell' start_cell
  102. 'GetValue'
  103. testlabel=result
  104. testlabel=strip(testlabel)
  105. if datatype(testlabel,'n')=1 then do
  106.     labelflag=0
  107.     do x=1 to NCols
  108.     title.x="Column "||x
  109.     end
  110. end
  111. else do
  112.     labelflag=1
  113.     NRows=NRows-1
  114.     do x=1 to NCols
  115.     'GetValue'
  116.     str=result
  117.     title.x=translate(strip(str),"_"," ")
  118.     'Column 1'
  119.     end
  120. end
  121. if fo then call writech(6Info,"Progress...10 ")
  122. /* Get data from cell range */
  123. col=start_col
  124. lav=0
  125. tot=0
  126. count.=0
  127. total.=0
  128. do x=1 to NCols
  129.     'SelectCell' top_cell.col
  130.     if labelflag=1 then 'CursorDown 1'
  131.     do y=1 to NRows
  132.         'GetValue'
  133.         valtest=result
  134.         if datatype(valtest)='NUM' then do
  135.             'GetValue'
  136.             val=result
  137.             val=strip(val)
  138.             data.x.y=val
  139.             tot=tot+val
  140.             total.x=tot
  141.             count.x=1+count.x
  142.         end
  143.         'CursorDown 1'
  144.     end
  145.     col=col+1
  146.     tot=0
  147.     lav=0
  148.     val=0
  149. end
  150. if fo then call writech(6Info,"20 ")
  151.  
  152. /* Calculate Forecast Values */
  153. z=1
  154. x=1
  155. dact.=0
  156. summ.=0
  157. serr.=0
  158. Fval.=0
  159. if init=0 then Fval.1.1=data.1.1
  160. else Fval.1.1=init
  161. do y=2 to NRows
  162.     z=y-1
  163.     /*Fval.x.z=(Fval.x.y)+a*((data.x.y)-(Fval.x.y))*/
  164.     /*Fval.x.y=a*(data.x.y)+(1-a)*Fval.x.z*/
  165.     /*Fval.x.y=a*(Fval.x.z)+(1-a)*data.x.y*/
  166.     Fval.x.y=(Fval.x.z)+a*((data.x.z)-(Fval.x.z))
  167. end
  168. if fo then call writech(6Info,"40 ")
  169. do y=2 to NRows
  170.     dact.y=((data.x.y)-(Fval.x.y))**2
  171. end
  172. if fo then call writech(6Info,"60 ")
  173. do w=1 to 4
  174.     serr.w=0
  175. end
  176. if fo then call writech(6Info,"80 ")
  177. do w=2 to NRows
  178.     do y=1 to w
  179.     summ.w=(summ.w)+(dact.y)
  180.     end
  181.     serr.w=sqrt((summ.w)/w)
  182. end
  183. if fo then do
  184.     call writeln(6Info,"100 ")
  185.     call writeln(6Info,"Writing output to window...")
  186. end
  187. /* Output */
  188. 'SelectCell' out_cell
  189. 'ColumnWidth 15'
  190. 'Put "Exponential Smoothing"'
  191. 'CursorDown 2'
  192. do x=1 to NCols
  193.     'GetCursorPos'
  194.     first_cell.x=result
  195.     title=""""||title.x||""""
  196.     'Put' title
  197.     'CursorDown 1'
  198. end
  199. x=1
  200. 'Put "Forecast Values"'
  201. 'CursorDown 1'
  202. do y=1 to NRows
  203.     'Put' format(Fval.x.y,,4)
  204.     'CursorDown 1'
  205. end
  206. 'CursorDown 2'
  207. 'Put' "Smoothing"
  208. 'CursorDown 1'
  209. 'Put' "Constant="
  210. 'SelectCell' out_cell
  211. 'Column 1'
  212. 'ColumnWidth 15'
  213. 'CursorDown 3'
  214. 'Put "Standard Error"'
  215. 'CursorDown 1'
  216. do y=1 to NRows
  217.     'Put' format(serr.y,,4)
  218.     'CursorDown 1'
  219. end
  220. 'CursorDown 3'
  221. 'Put' a
  222. 'Refresh 1'
  223. 'Refresh 2'
  224. /*'Message' "Finished"*/
  225. /*indicate the main script is finished*/
  226. DisplayMsg="Cleaning up ...."||CR||"Exiting"
  227. result=writeln(6Info, DisplayMsg)
  228. if result~=0 then do
  229.     /*Wait 3 seconds*/
  230.     CALL DELAY(150)
  231.     /* close window*/
  232.     result=close(6Info)
  233. end
  234. 'DEFPUBSCREEN("Workbench")'
  235. exit
  236.  
  237. /* Procedures */
  238.  
  239. cellrow: procedure
  240. do
  241.     parse arg cell
  242.     do charpos=2 to length(cell)
  243.     if datatype(substr(cell,charpos,1),n) then return substr(cell,charpos)
  244.     end
  245.     return 0
  246. end
  247. Return
  248.  
  249. cellcol: procedure
  250. do
  251.     parse arg cell
  252.     labels="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  253.     cell=upper(cell)
  254.     len=length(cell)
  255.     val=0
  256. do charpos=1 to len
  257.     if datatype(substr(cell,charpos,1),n) then
  258.     do cell=reverse(substr(cell,1,charpos-1))
  259.     do x=1 to length(cell)
  260.     val=(26**(x-1))*pos(substr(cell,x,1),labels)+val
  261.     end
  262.     return val
  263.     end
  264.     end
  265.     return 0
  266. end
  267. Return
  268. /* It is important to put the exposed array at the end of the next line */
  269. Sort: procedure expose NCols NRows data.
  270. do x=1 to NCols
  271. L=(xtoy(2,int(log(NRows)/log(2))))-1
  272.     Do Until L<1
  273.     L=trunc(int(L/2))
  274.     Do J=1 to L
  275.             Do K=J+L To NRows By L
  276.             I=K
  277.             dumdat=data.x.I
  278.             Do while I>L
  279.                 y=I-L
  280.                 If data.x.y ~> dumdat then Leave
  281.                 data.x.I=data.x.y
  282.                 I=I-L
  283.             End
  284.             data.x.I=dumdat
  285.             End
  286.         End
  287.     End
  288. End
  289. Return
  290.  
  291. syntax:
  292.      if arg(1)='FAIL' then do
  293.         'Message "Library is unavailable."'
  294.         'DEFPUBSCREEN("Workbench")'
  295.         exit
  296.         end
  297.     'DEFPUBSCREEN("Workbench")'
  298.     exit
  299.  
  300. Format:  procedure
  301.  
  302.      arg number, before, after
  303.      CallLine = SIGL
  304.      if ~datatype(CallLine, 'N') then CallLine = '??'
  305.  
  306.      /* Make sure we have a number as first (required) argument    */
  307.      if ~datatype(number, 'N') then do
  308.         if number = '' then
  309.            fc = 17     /* Wrong number of arguments           */
  310.         else
  311.            fc = 47     /* Arithmetic conversion error             */
  312.         signal FormatSyntaxError
  313.      end
  314.      num = number + 0
  315.      if before = '' & after = '' then
  316.         return num
  317.      else do
  318.         parse var num integer '.' fraction
  319.         if before = '' then before = length(integer)
  320.         if after = '' then after = length(fraction)
  321.         if ~datatype(before, N) | ~datatype(after, N) then
  322.            do fc = 18
  323.            signal FormatSyntaxError
  324.        end
  325.         if before < length(integer) then do
  326.            fc = 18
  327.            signal FormatSyntaxError
  328.         end
  329.         if after ~= length(fraction) then do
  330.            fraction = trunc(('.'fraction'0') + ('.'copies('0', after)'5'), after)
  331.         if integer<1&integer>-1 then integer=integer
  332.            else integer = integer + (fraction % 1)
  333.            fraction = substr(fraction, 3)
  334.         end
  335.         if fraction >= 0 then
  336.            return right(integer, before)'.'fraction
  337.         else
  338.            return right(integer, before)
  339.      end
  340.  
  341.  FormatSyntaxError:
  342.         if show('F', STDERR) then
  343.            call writeln(STDERR, '+++ Error' fc 'in line' CallLine':' errortext(fc))
  344.         else
  345.            mess='+++ Error' fc 'in line' CallLine':' errortext(fc)
  346.         'Message' mess
  347.         parse source Func .
  348.         if Func = 'FUNCTION' then do
  349.         'DEFPUBSCREEN("Workbench")'
  350.            exit "Err"
  351.         end
  352.         else do
  353.         'DEFPUBSCREEN("Workbench")'
  354.            exit 10
  355.         end